use strict;
use warnings;

package Lingua::EN::WSD::WebBased::Utils;

use base qw/Exporter/;

use Exporter;
use DB_File;
use List::Util;
use List::MoreUtils qw/pairwise uniq/;
use Storable qw/dclone thaw freeze/;

use Lingua::EN::WSD::WebBased::Logger;

our @EXPORT = qw/
    sum
    check_type
    combine_vectors
    load_wordnet
    select_vocabulary_from_wordnet
    clear_html
    build_dmoz_structure_db
    load_dmoz_structure_db
    query_dmoz_structure_db
/;

# a fix on List::Util::sum

sub sum {

    goto &List::Util::sum if @_ > 0;

    return 0;

}

# check object type

sub check_type {

    my ($name, $obj, $type) = @_;
    if (!defined $obj || ref $obj ne $type) {
        _error("$name should be of class $type", {depth_adjustment => 1});
    }
    
}

# combine several tf vectors into one

sub combine_vectors {

    my %vector;
    for my $v (@_) {
        while (my ($term, $freq) = each %$v) {
            $vector{$term} += $freq;
        }
    }

    return \%vector;

}

# load WordNet

sub load_wordnet {

    my $wordnet_path = shift;

    use WordNet::QueryData;
    _trace("Start loading WordNet from $wordnet_path");
    my $wn = new WordNet::QueryData($wordnet_path);
    _trace("Finish loading WordNet");

    return $wn;    

}

# select a vocabulary from WordNet

sub select_vocabulary_from_wordnet {

    my $wn = shift;

    my %pos_map = (
        noun        => 'n',
        verb        => 'v',
        adjective   => 'a',
        adverb      => 'r'
    );

    my @vocabulary = ();

    for my $pos (keys %pos_map) {
        for my $word ($wn->listAllWords($pos)) {
            if ($word !~ /_|-|'/ &&
                defined $wn->tagSenseCnt("$word#$pos_map{$pos}"))
            {
                push @vocabulary, $word;
            }
        }
    }

    @vocabulary = uniq @vocabulary;

    _trace('Vocabulary size: ', scalar @vocabulary);
    
    return \@vocabulary;

}

# clear raw HTML

sub clear_html {

    my $str = shift;

    my $desc = do {
        $str =~ /meta[^>]+?name="description"[^>]+?content="(.*?)"/i; $1
    } || '';
    my $keywords = do {
        $str =~ /meta[^>]+?name="keywords"[^>]+?content="(.*?)"/i; $1
    } || '';
    1 while $str =~ s/<script.*?\/script>/<script>/gis;
    $str =~ s/<style.*?\/style>//gis;
    $str =~ s/<!--.*?-->//gs;
    $str =~ s/<.*?>//gs;
    $str = "$desc $keywords $str";
    $str =~ s/&.*?;//g;
    $str =~ s/\s+/ /g;

    return $str;

}


# convert the dmoz structure dump file to a fast-accessing DB file,
# the dump file is downloaded from: http://rdf.dmoz.org/rdf/structure.rdf.u8.gz

sub build_dmoz_structure_db {    

    my ($structure_file, $db_file) = @_;
    my $n = 0;
    tie my %db, 'DB_File', $db_file, O_RDWR | O_CREAT, 0666, $DB_BTREE
        || die "Cannot open db $db_file";
    open my $structure, "<:utf8", $structure_file;
    while (<$structure>) {
        if (/Topic r:id="(.*?)"/) {
            my $topic = $1;
            next if $topic !~ /^[[:ascii:]]+$/;
            my @subtopic = ();
            my ($catid, $title, $desc);
            while (<$structure>) {
                if (/<catid>(.*?)</) {
                    $catid = $1;
                }
                if (/<d:Title>(.*?)</) {
                    $title = $1;
                }
                elsif (/<d:Description/) {
                    $desc = $_;
                    if (!/<\/d:Description/) {
                        while (<$structure>) {
                            $desc .= $_;
                            last if /<\/d:Description/;
                        }
                    }
                    $desc =~ s/<.*?>//g;
                    $desc = decode_entities($desc);
                }
                elsif (/<narrow r:resource="(.*?)"/) {
                    my $subtopic = $1;
                    $subtopic =~ /\/([^\/]+)$/;
                    $subtopic = $1;
                    push @subtopic, $subtopic;
                }
                last if /<\/Topic/;
            }
            $db{$topic} = freeze [\@subtopic, $catid, $title, $desc];
            $n++;
            print STDERR "\r$n";
        }
    }
    close $structure;
    print STDERR "\n";

}

# load the dmoz structure DB file

sub load_dmoz_structure_db {
    
    my ($db_file) = @_;
    tie my %db, 'DB_File', $db_file, O_RDONLY, 0666, $DB_BTREE
        || die "Cannot open db $db_file";
    \%db;

}

# query the dmoz structure DB file with path

sub query_dmoz_structure_db {

    my ($db, $query) = @_;
    $query =~ s/ /_/g;
    my $r = thaw $db->{$query};
    if (defined $r) {
        $r->[2] =~ s/_/ /g;
        for (@{$r->[0]}) { $_ =~ s/_/ /g }
        return {
            subtopic => $r->[0],
            catid => $r->[1],
            title => $r->[2],
            desc => $r->[3]
        };
    }
    else {
        return {
            subtopic => [],
            catid => '',
            title => '',
            desc => ''
        };
    }

}


1;
